home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
b
/
b.lha
/
B
/
src
/
bed
/
bobj.c
< prev
next >
Wrap
C/C++ Source or Header
|
1988-11-24
|
10KB
|
646 lines
/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
static char rcsid[] = "$Header: bobj.c,v 2.5 85/08/22 15:59:59 timo Exp $";
/*
* B editor -- A shrunken version of the B interpreter's run-time system.
*/
#include "b.h"
#include "bobj.h"
#include "node.h"
#define COMPOUNDS
string malloc();
string calloc();
string realloc();
string strcpy();
extern bool dflag;
struct head {
char type;
intlet refcnt;
intlet len;
};
#define Intsize (sizeof(int))
#define Hsize (sizeof(struct head))
#define Headsize (((Hsize-1)/Intsize + 1) * Intsize)
#define Field(v, i) (((value *)&(v)->cts)[i])
#ifndef NDEBUG
/* Statistics on allocation/sharing */
int nobjs;
int nrefs;
#define Increfs ++nrefs
#define Decrefs --nrefs
#else NDEBUG
#define Increfs
#define Decrefs
#endif NDEBUG
#define Copy(v) if ((v) && Refcnt(v) < Maxintlet) { ++Refcnt(v); Increfs; }
#define Release(v) if (!(v) || Refcnt(v) == Maxintlet) ; else RRelease(v)
#define RRelease(v) \
if (Refcnt(v) > 1) { --Refcnt(v); Decrefs; } else release(v)
/*
* Allocate a value with nbytes of data after the usual type, len, refcnt
* fields.
*/
value
grabber(nbytes)
register int nbytes;
{
register value v = (value) malloc((unsigned) (Headsize + nbytes));
if (!v)
syserr("grabber: malloc");
#ifndef NDEBUG
if (dflag)
newval(v);
#endif
#ifndef NDEBUG
++nobjs;
#endif
Increfs;
v->refcnt = 1;
return v;
}
/*
* Reallocate a value with nbytes of data after the usual type, len, refcnt
* fields.
*/
value
regrabber(v, nbytes)
register value v;
register int nbytes;
{
Assert(v && v->refcnt == 1);
v = (value) realloc((char*)v, (unsigned) (Headsize + nbytes));
if (!v)
syserr("regrabber: realloc");
return v;
}
/*
* Set an object's refcnt to infinity, so it will never be released.
*/
fix(v)
register value v;
{
register int i;
register node n;
register path p;
Assert(v->refcnt > 0);
#ifndef NDEBUG
if (v->refcnt < Maxintlet)
nrefs -= v->refcnt;
#endif
v->refcnt = Maxintlet;
#if OBSOLETE
switch (v->type) {
case Tex:
break;
case Nod:
n = (node)v;
for (i = v->len - 1; i >= 0; --i)
if (n->n_child[i])
fix((value)(n->n_child[i]));
break;
case Pat:
p = (path)v;
if (p->p_parent)
fix((value)(p->p_parent));
if (p->p_tree)
fix((value)(p->p_tree));
break;
#ifdef COMPOUNDS
case Com:
for (i = v->len-1; i >= 0; --i)
if (Field(v, i))
fix(Field(v, i));
break;
#endif COMPOUNDS
#ifdef SLOW_INTS
case Num:
#endif SLOW_INTS
default:
Abort();
}
#endif OBSOLETE
}
#ifdef COMPOUNDS
/*
* Allocate a compound with n fields.
*/
Visible value
grab_com(n)
int n;
{
value v = grabber(n*sizeof(value));
v->type = Com;
v->len = n;
for (--n; n >= 0; --n)
Field(v, n) = Vnil;
return v;
}
#endif COMPOUNDS
/*
* Allocate a node with nch children.
*/
node
grab_node(nch)
register int nch;
{
register node n = (node) grabber(
sizeof(struct node) - Headsize +
sizeof(value) * (nch-1));
register int i;
n->type = Nod;
n->len = nch;
n->n_marks = 0;
n->n_width = 0;
n->n_symbol = 0;
for (i = nch-1; i >= 0; --i)
n->n_child[i] = Nnil;
return n;
}
/*
* Allocate a path.
*/
path
grab_path()
{
register path p = (path) grabber(
sizeof(struct path) - Headsize);
p->type = Pat;
p->p_parent = Pnil;
p->p_tree = Nnil;
p->p_ichild = 0;
p->p_ycoord = 0;
p->p_xcoord = 0;
p->p_level = 0;
p->p_addmarks = 0;
p->p_delmarks = 0;
return p;
}
#ifdef SLOW_INTS
/*
* Make an integer.
*/
value
mk_integer(i)
int i;
{
value v;
static value tab[128];
if (!i)
return Vnil;
if (!(i&~127) && tab[i])
return tab[i];
v = grabber(sizeof(value));
v->type = Num;
Field(v, 0) = (value) i;
if (!(i&~127)) {
tab[i] = v;
v->refcnt = Maxintlet;
}
return v;
}
#endif SLOW_INTS
/*
* Make a text object out of a C string.
*/
value
mk_text(str)
register string str;
{
register int len = strlen(str);
register value v = grabber(len+1);
v->type = Tex;
v->len = len;
strcpy(Str(v), str);
return v;
}
/*
* Concatenate a C string to a text object (at the end).
*/
concato(pv, str)
register value *pv;
register string str;
{
register value v = *pv;
register int vlen = v->len;
register int len = strlen(str);
Assert(v && v->refcnt > 0);
if (!len)
return;
len += vlen;
if (v->refcnt == 1)
v = regrabber(v, len+1);
else {
v = grabber(len+1);
v->type = Tex;
strcpy(Str(v), Str(*pv));
Release(*pv);
}
strcpy(Str(v) + vlen, str);
v->len = len;
*pv = v;
}
/*
* Return a substring (trim) of a text object.
*/
value
trim(v, behead, curtail)
register value v;
register int behead;
register int curtail;
{
register value w;
register int c;
Assert(v && v->refcnt > 0);
Assert(behead >= 0 && curtail >= 0 && behead+curtail <= v->len);
if (behead + curtail == 0) {
Copy(v);
return v;
}
c = Str(v)[v->len - curtail];
Str(v)[v->len - curtail] = 0; /* TEMPORARILY */
w = mk_text(Str(v) + behead);
Str(v)[v->len - curtail] = c;
return w;
}
#ifdef SLOW_INTS
/*
* Return the C value if an integer object.
*/
int
intval(v)
register value v;
{
if (!v)
return 0;
return (int) Field(v, 0);
}
#endif SLOW_INTS
/*
* Make sure a location (pointer variable) contains a unique object.
*/
uniql(pv)
register value *pv;
{
register value v = *pv;
register value w;
register path p;
register node n;
register int i;
Assert(v && v->refcnt > 0);
if (v->refcnt == 1)
return;
switch (v->type) {
case Nod:
n = grab_node(v->len);
for (i = v->len - 1; i >= 0; --i) {
w = (value) (n->n_child[i] = ((node)v)->n_child[i]);
Copy(w); /* This is ugly */
}
n->n_marks = ((node)v)->n_marks;
n->n_width = ((node)v)->n_width;
n->n_symbol = ((node)v)->n_symbol;
w = (value)n;
break;
case Pat:
p = grab_path();
p->p_parent = ((path)v)->p_parent;
Copy(p->p_parent);
p->p_tree = ((path)v)->p_tree;
Copy(p->p_tree);
p->p_ichild = ((path)v)->p_ichild;
p->p_ycoord = ((path)v)->p_ycoord;
p->p_xcoord = ((path)v)->p_xcoord;
p->p_level = ((path)v)->p_level;
w = (value)p;
break;
#ifdef SLOW_INTS
case Num:
w = mk_integer(intval(v));
break;
#endif SLOW_INTS
#ifdef COMPOUNDS
case Com:
w = grab_com(v->len);
for (i = v->len - 1; i >= 0; --i) {
n = (node) (Field(w, i) = Field(v, i));
Copy(n); /* This is uglier */
}
break;
#endif COMPOUNDS
case Tex:
w = mk_text(Str(v));
break;
default:
Abort();
}
Release(v);
*pv = w;
}
/*
* Increase the reference count of an object, unless it is infinite.
*/
value
copy(v)
value v;
{
if (!v)
return v;
Assert(v->refcnt > 0);
if (v->refcnt < Maxintlet) {
++v->refcnt;
Increfs;
}
return v;
}
/*
* Decrease the reference count of an object, unless it is infinite.
* If it reaches zero, free the storage occupied by the object.
*/
release(v)
register value v;
{
register int i;
register value w;
if (!v)
return;
Assert(v->refcnt > 0);
if (v->refcnt == Maxintlet)
return;
Decrefs;
--v->refcnt;
if (v->refcnt == 0) {
switch (v->type) {
#ifdef SLOW_INTS
case Num:
#endif SLOW_INTS
case Tex:
break;
#ifdef COMPOUNDS
case Com:
for (i = v->len - 1; i >= 0; --i) {
w = Field(v, i);
Release(w);
}
break;
#endif COMPOUNDS
case Nod:
for (i = v->len - 1; i >= 0; --i) {
w = (value)(((node)v)->n_child[i]);
Release(w);
}
break;
case Pat:
w = (value)(((path)v)->p_parent);
Release(w);
w = (value)(((path)v)->p_tree);
Release(w);
break;
default:
Abort();
}
#ifndef NDEBUG
if (dflag)
delval(v);
--nobjs;
#endif NDEBUG
free((string)v);
}
}
objstats()
{
#ifndef NDEBUG
fprintf(stderr, "*** Object statistics: %d objects, %d references\n",
nobjs, nrefs);
#ifdef MSTATS
mstats("(at end)"); /* A routine which some malloc versions have to print
memory statistics. Remove if your malloc hasn't. */
#endif MSTATS
#endif NDEBUG
}
#ifndef NDEBUG
valdump(v)
value v;
{
if (!v)
fputs("(nil)", stderr);
else {
fprintf(stderr, "v=0x%x, type='%c', len=%d, refcnt=",
v, v->type, v->len);
if (v->refcnt == Maxintlet)
putc('*', stderr);
else
fprintf(stderr, "%d", v->refcnt);
fputs(": ", stderr);
wrval(v);
}
putc('\n', stderr);
}
#define QUOTE '\''
wrval(v)
value v;
{
register string cp;
register int c;
if (!v) {
fputs("nil", stderr);
return;
}
switch (v->type) {
#ifdef SLOW_INTS
case Num:
fprintf(stderr, "%d", intval(v));
break;
#endif SLOW_INTS
case Tex:
putc(QUOTE, stderr);
for (cp = Str(v); c = *cp; ++cp) {
if (' ' <= c && c < 0177) {
putc(c, stderr);
if (c == QUOTE)
putc(c, stderr);
}
else if (0 <= c && c < ' ')
putc('^', stderr), putc(c + '@', stderr);
else
fprintf(stderr, "\\%03o", c);
}
putc(QUOTE, stderr);
break;
#ifdef COMPOUNDS
case Com:
{
int i;
value f;
putc('(', stderr);
for (i = 0; i < v->len; ++i) {
if (i)
putc(',', stderr), putc(' ', stderr);
f = Field(v, i);
if (!f || f->refcnt == 1 || f->type != Com) {
if (f && f->type == Com)
fprintf(stderr, "0x%x=", f);
wrval(f);
}
else
fprintf(stderr, "0x%x", f);
}
putc(')', stderr);
break;
}
#endif COMPOUNDS
default:
fprintf(stderr, "0x%x", v);
}
}
static struct list {
struct list *link;
value val;
} head;
#endif NDEBUG
objdump()
{
#ifndef NDEBUG
struct list *l;
for (l = head.link; l; l = l->link)
valdump(l->val);
#endif NDEBUG
}
objcheck()
{
#ifndef NDEBUG
struct list *l;
for (l = head.link; l; l = l->link)
if (l->val->refcnt != Maxintlet)
valdump(l->val);
#endif NDEBUG
}
#ifndef NDEBUG
newval(v)
register value v;
{
register struct list *l =
(struct list *) malloc((unsigned) sizeof(struct list));
if (!l)
syserr("newval: malloc");
l->link = head.link;
l->val = v;
head.link = l;
}
delval(v)
register value v;
{
register struct list *l;
register struct list *p;
for (p = &head, l = head.link; l; p = l, l = l->link) {
if (l->val == v) {
p->link = l->link;
free((string)l);
return;
}
}
Abort();
}
#endif NDEBUG